Network Support Library/RoseWare - Network Support Library.iso/apidev/nwt2.exe/SERVINFO.FRM

Text File | 1993-08-10 | 10KB | 324 lines

VERSION 2.00
Begin Form ServerInfoForm
   Caption         =   "User Information"
   ClientHeight    =   4335
   ClientLeft      =   1095
   ClientTop       =   1485
   ClientWidth     =   6390
   Height          =   4740
   Left            =   1035
   LinkTopic       =   "Form1"
   ScaleHeight     =   4335
   ScaleWidth      =   6390
   Top             =   1140
   Width           =   6510
   Begin CommandButton DoneButton
      Caption         =   "&Done"
      Default         =   -1  'True
      Height          =   375
      Left            =   5400
      TabIndex        =   6
      Top             =   120
      Width           =   855
   End
   Begin ListBox GroupList
      Height          =   1200
      Left            =   360
      TabIndex        =   1
      Top             =   2520
      Width           =   4935
   End
   Begin ListBox TrusteePathList
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Courier New"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   1230
      Left            =   360
      TabIndex        =   0
      Top             =   720
      Width           =   4935
   End
   Begin Label DriveLabel
      Height          =   255
      Left            =   360
      TabIndex        =   7
      Top             =   3960
      Width           =   5055
   End
   Begin Label Label3
      Caption         =   "Group membership:"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   2280
      Width           =   1695
   End
   Begin Label VolumeLabel
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   480
      Width           =   4575
   End
   Begin Label UserNameLabel
      Height          =   255
      Left            =   840
      TabIndex        =   3
      Top             =   120
      Width           =   3375
   End
   Begin Label Label1
      Caption         =   "User:"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   495
   End
End

Function AttachToServer (serverName$, userName$, password$) As Integer
'returns connection ID of specified server if already logged in
'logs in and returns connection ID, if not already logged in
'returns 0 if unable to log in
'password and username can be empty if already logged in to
'   specified server

    Dim loginTime As DATE_AND_TIME

    cCode% = GetConnectionID(serverName$, connectionID%)
    If (cCode% <> SUCCESSFUL) Then
        'either we're not attached, or we're already attached
        If (connectionID% = 0) Then
            'we're not attached
            alreadyAttached% = False
            'Get an attachment to server
            cCode% = AttachToFileServer(serverName$, connectionID%)
            If (cCode% <> SUCCESSFUL) Then
                AttachToServer = 0
                Exit Function
            End If
        End If
    End If

    'see if we're logged in, or just attached
    SetPreferredConnectionID (connectionID%)
    connNum& = GetConnectionNumber()
    oName$ = String$(48, 0)
    cCode% = GetConnectionInformation(connNum&, oName$, oType%, oID&, loginTime)

    If (cCode% = SUCCESSFUL) Then
        'we're logged in
        AttachToServer = connectionID%
        alreadyAttached% = True

    Else
        'then log in
        cCode% = LoginToFileServer(userName$, OT_USER, password$)
        If (cCode% <> SUCCESSFUL) Then
            AttachToServer = 0
        Else
            AttachToServer = connectionID%
        End If
        alreadyAttached% = False
    End If
End Function

Function DisconnectFromServer (connectionID%) As Integer
    cCode% = DetachFromFileServer(connectionID%)
    If (cCode% = SUCCESSFUL) Then
        DisconnectFromServer = True
    Else
        DisconnectFromServer = False
    End If
End Function

Sub DoneButton_Click ()
    End
End Sub

Sub Form_Load ()
    'we are assuming that the user has the same username on the default server
    '  and on the server we are attaching to
    connectionID% = AttachToServer(serverName$, userName$, password$)
    If (connectionID% = 0) Then
        MsgBox "Unable to attach to server " + serverName$, MB_OK, "Error"
    Else
        If (MapDriveLetter(connectionID%) <> True) Then
            MsgBox "Unable to map network drive", MB_OK, "Error"
        Else
            DriveLabel.Caption = "Successfully mapped drive to " + serverName$ + "/" + netPath$
        End If

        If (GetTrusteeInformation() <> True) Then
            MsgBox "Error getting trustee information", MB_OK, "Error"
        End If

        If (GetGroupInformation() <> True) Then
            MsgBox "Error getting group  information", MB_OK, "Error"
        End If

        If (Not alreadyAttached%) Then
            If (DisconnectFromServer(connectionID%) <> True) Then
                MsgBox "Error disconnecting from server " + serverName$, MB_OK, "Error"
            End If
        End If
    End If

    'restore preferred connection ID
    SetPreferredConnectionID (originalPreferredServer%)
End Sub

Function GetGroupInformation () As Integer
    Dim loginTime As DATE_AND_TIME
    Dim seg As PROPERTY_VALUE

    'we already called GetConnectionNumber and GetConnectionInformation
    '  to get the bindery object information in GetTrusteeInformation,
    '  but we'll do it again here, just to keep the two procedures
    '  independent of each other
    connectionNumber& = GetConnectionNumber()
    userName$ = String$(48, 0)
    cCode% = GetConnectionInformation(connectionNumber&, userName$, objectType%, objectID&, loginTime)
    If (cCode% <> SUCCESSFUL) Then
        GetGroupInformation = False
    Else
        segNum% = 1
        Do
            cCode% = ReadPropertyValue(userName$, objectType%, "GROUPS_I'M_IN", segNum%, seg, moreSegs%, flags%)
            i% = 0
            Do
                'the segment returned by ReadProperty value is an array of up to
                '  32 longs, each the bindery object ID of a group
                objectID& = LongSwap(seg.propertyValue(i%))
                If (objectID& <> 0) Then
                    objectName$ = String$(48, 0)
                    cCode2% = GetBinderyObjectName(objectID&, objectName$, objectType%)
                    If (cCode2% = NO_SUCH_OBJECT) Then
                        GroupList.AddItem "UNKNOWN"
                    ElseIf (cCode2% = SUCCESSFUL) Then
                        GroupList.AddItem objectName$
                    Else
                        MsgBox "Error getting name of group", MB_OK, "Error"
                    End If
                    i% = i% + 1
                End If
            Loop While ((objectID& <> 0) And (i% < 128))
            segment% = segment% + 1
        Loop While ((cCode% = SUCCESSFUL) And (moreSegs% = 255))

        If (moreSegs% = 255) Then
            GetGroupInformation = False
        Else
            GetGroupInformation = True
        End If
    End If
End Function

Function GetRights (rightsMask%) As String
'Returns a string corresponding to the trustee rights for
'   the specified rights mask.  Assumes NetWare v3.x/4.x
'   See NWDIR.BAS for global const declarations for
'   NetWare v2. x rights

    If (rightsMask% And TR_READ) Then
        rights$ = "R"
    Else
        rights$ = " "
    End If

    If (rightsMask% And TR_WRITE) Then
        rights$ = rights$ + "W"
    Else
        rights$ = rights$ + " "
    End If

    If (rightsMask% And TR_CREATE) Then
        rights$ = rights$ + "C"
    Else
        rights$ = rights$ + " "
    End If

    If (rightsMask% And TR_ERASE) Then
        rights$ = rights$ + "E"
    Else
        rights$ = rights$ + " "
    End If

    'access control
    If (rightsMask% And TR_ACCESS) Then
        rights$ = rights$ + "A"
    Else
        rights$ = rights$ + " "
    End If

    'file scan
    If (rightsMask% And TR_FILE) Then
        rights$ = rights$ + "F"
    Else
        rights$ = rights$ + " "
    End If

    'modify file attributes
    If (rightsMask% And TR_MODIFY) Then
        rights$ = rights$ + "M"
    Else
        rights$ = rights$ + " "
    End If

    If (rightsMask% And TR_SUPERVISOR) Then
        rights$ = rights$ + "S"
    Else
        rights$ = rights$ + " "
    End If

    GetRights = rights$
End Function

Function GetTrusteeInformation () As Integer
    Dim loginTime As DATE_AND_TIME

    connectionNumber& = GetConnectionNumber()
    userName$ = String$(48, 0)
    cCode% = GetConnectionInformation(connectionNumber&, userName$, objectType%, objectID&, loginTime)
    If (cCode% <> SUCCESSFUL) Then
        GetTrusteeInformation = False
    Else
        volume% = 0
        volumeName$ = String$(16, 0)
        cCode% = GetVolumeName(0, volumeName$)
        VolumeLabel.Caption = "Trustee rights for volume " + volumeName$ + ":"
        sequence% = 0
        Do
            trusteePath$ = String$(255, 0)
            cCode% = ScanBinderyObjectTrusteePaths(objectID&, volume%, sequence%, accessMask%, trusteePath$)
            If ((cCode% = SUCCESSFUL) And (Asc(trusteePath$) <> 0)) Then
                rights$ = GetRights(accessMask%)
                TrusteePathList.AddItem rights$ + "  " + trusteePath$
            End If
        Loop While ((cCode% = SUCCESSFUL) And (Asc(trusteePath$) <> 0))

        If (cCode% <> SUCCESSFUL) Then
            GetTrusteeInformation = False
        Else
            GetTrusteeInformation = True
        End If
    End If
End Function

Function MapDriveLetter (connectionID%) As Integer
    'pass a null in driveLetter$ to map next available drive
    driveLetter$ = Chr$(0)
    netPath$ = "SYS:\"
    cCode% = MapDrive(connectionID%, NO_BASE_DRIVE, netPath$, DRIVE_ADD, 0, driveLetter$)
    If (cCode% = SUCCESSFUL) Then
        MapDriveLetter = True
    Else
        MapDriveLetter = False
    End If
End Function